home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HyperLib 1997 Winter - Disc 1
/
HYPERLIB-1997-Winter-CD1.ISO.7z
/
HYPERLIB-1997-Winter-CD1.ISO
/
オンラインウェア
/
UTIL
/
Alpha 6.5.sit
/
Tcl
/
Menus
/
thinkMenu.tcl
< prev
next >
Wrap
Text File
|
1996-08-15
|
8KB
|
332 lines
# (nowrap)
if $startingUp {
set thinkMenu "・300"
addMenu thinkMenu
return
}
proc thinkMenu {} {}
# The menu
menu -n $thinkMenu {
"/S<O<Uthink"
"openHeader"
"menu -n thinkFlags {}"
"createThinkFileset"
"(-"
"/K<O<Ucompile"
"checkSyntax"
"/T<O<UsearchNextFile"
"(-"
"add"
"addAndCompile"
"(-"
"disassemble"
"preprocess"
"precompile"
"(-"
"bringUpToDate"
"/¥¥<O<Umake"
"(-"
"/I<O<Udebug"
"/R<O<Urun"
}
# The following flags affect Think's "Run" command.
# THINK will crash if you set the debugger flag and your
# project does not have debugging information.
if {![info exists thinkdebugger]} {set thinkdebugger 0}
if {![info exists thinkgo]} {set thinkgo 1}
if {![info exists thinksaveDirty]} {set thinksaveDirty 1}
if {![info exists thinkupdate]} {set thinkupdate 1}
menu -n thinkFlags -p thinkFlagsProc {"debugger" "go" "saveDirty" "update"}
markMenuItem thinkFlags debugger $thinkdebugger
markMenuItem thinkFlags go $thinkgo
markMenuItem thinkFlags saveDirty $thinksaveDirty
markMenuItem thinkFlags update $thinkupdate
proc thinkFlagsProc {menu item} {
global think$item modifiedVars
set think$item [expr -1 * ([set think$item] - 1)]
markMenuItem thinkFlags $item [set think$item]
lappend modifiedVars think$item
}
set THINK "THINK Project Manager"
#set THINK "AEvent Display 1.3"
proc thinkNumFiles {} {
global THINK
set str [AEBuild -r $THINK "core" "cnte" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}} "kocl" "type('SFIL')"]
if {[regexp {[0-9]+} $str mtch]} {
return $mtch
} else {
error "Bad numfiles"
}
}
# Get list of files in current project.
proc projectFileList args {
global SymCompSig
watchCursor
launchBackAppl $SymCompSig
set num [thinkNumFiles]
set files {}
for {set i 1} {$i<=$num} {incr i} {
set f [thinkFileName $i]
if {[getFileType $f] == "TEXT"} {
lappend files $f
}
}
return $files
}
#================================================================================
proc think {} {
global SymCompSig
launchForeAppl $SymCompSig
}
proc searchNextFile {} {
thinkFinf
}
#===========================================================================
# Add fileset.
#===========================================================================
proc createThinkFileset {} {
global gfileSets gfileSetsType
set name [prompt "Fileset name? " "THINK"]
set gfileSets($name) [lsort -command sortByTail [projectFileList]]
set gfileSetsType($name) think
if {[askyesno "Save project fileset?"] == "yes"} {
addArrDef gfileSets $name $gfileSets($name)
}
return $name
}
#================================================================================
proc compile {} {
sendCompileEvent CMPL "-r"
}
proc checkSyntax {} {
sendCompileEvent SNTX "-q"
}
proc disassemble {} {
global THINK ALPHA SymCompSig
getApplSig "Please locate $THINK" SymCompSig
set tname [file tail [launchForeAppl $SymCompSig]]
set name [car [winNames -f]]
set res [AEBuild -t 7200 -r $tname KAHL DASM CFLG long(32) "----" [fileObject $name]]
switchTo $ALPHA
new -n "* [file root [file tail $name]].asm *"
regexp {メ.*モ} $res text
insertText [string trim $text {メモ}]
setWinInfo dirty 0
goto 0
}
proc preprocess {} {
global THINK ALPHA SymCompSig
getApplSig "Please locate $THINK" SymCompSig
set tname [file tail [launchForeAppl $SymCompSig]]
set name [car [winNames -f]]
set res [AEBuild -r $tname KAHL PRCS CFLG long(32) "----" [fileObject $name]]
switchTo $ALPHA
new -n "* Preprocessed '[file tail $name]' *"
regexp {メ.*モ} $res text
insertText [string trim $text {メモ}]
}
proc sendCompileEvent {event arg} {
global THINK ALPHA SymCompSig
getApplSig "Please locate $THINK" SymCompSig
set tname [file tail [launchForeAppl $SymCompSig]]
set name [car [winNames -f]]
if {[string length $arg]} {
set err [catch {AEBuild -t 7200 $arg $tname KAHL $event "----" [fileObject $name]} res]
} else {
set err [catch {AEBuild -t 7200 $tname KAHL $event "----" [fileObject $name]} res]
}
if (!$err) {
set err [catch {switchTo $ALPHA} res]
}
if ($err) {
message $res
} else {
return $res
}
}
proc add {} {
global THINK
set fname [car [winNames -f]]
AEBuild $THINK core crel "data" [makeAlis $fname] "kocl" "type('SFIL')"
}
proc addAndCompile {} {
add
compile
}
proc precompile {} {
sendCompileEvent PCMP ""
}
proc bringUpToDate {} {
global THINK ALPHA SymCompSig
getApplSig "Please locate $THINK" SymCompSig
set name [file tail [launchForeAppl $SymCompSig]]
set res [AEBuild -q $name KAHL CMPL SLCT MAKE "CFLG" "long(2)" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}}]
switchTo $ALPHA
return $res
}
proc make {} {
global THINK ALPHA SymCompSig
getApplSig "Please locate $THINK" SymCompSig
set name [file tail [launchForeAppl $SymCompSig]]
set res [AEBuild -q $name KAHL CMPL SLCT MAKE "CFLG" "long(2)" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}}]
}
proc run {} {
global THINK thinkdebugger thinkgo thinksaveDirty thinkupdate SymCompSig
set dbug [expr {$thinkdebugger ? "bool(ヌ01ネ)" : "bool(ヌ00ネ)"}]
set go [expr {$thinkgo ? "bool(ヌ01ネ)" : "bool(ヌ00ネ)"}]
set update [expr {$thinkupdate ? "'yes '" : "'no '"}]
set dirty [expr {$thinksaveDirty ? "'yes '" : "'no '"}]
getApplSig "Please locate $THINK" SymCompSig
set name [file tail [launchForeAppl $SymCompSig]]
if {[catch {AEBuild -q $name KAHL "RUN " "DBUG" $dbug "GO " $go "UPDT" $update "savo" $dirty} res]} {
message $res
}
}
proc debug {} {
global THINK
switchTo 'ラLSD'
set fname [car [winNames -f]]
set row [expr [lindex [posToRowCol [getPos]] 0] - 1]
if {[catch {AEBuild $THINK KAHL DBGF "----" [makeAlis $fname] LNNO "short($row)" } res]} {
message $res
}
}
proc cnt {} {
global THINK
AEBuild -t 6000 -r $THINK core cnte "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}} "kocl" "type('sfil')"
}
proc thinkFileName {arg} {
global THINK
set event [join [concat {obj¥ ¥{want:type('prop'),¥ from:obj¥ ¥{want:type('SFIL'),¥ from:'null'(),¥ form:'indx',¥ seld:} $arg {¥},¥ form:'prop',¥ seld:type('FSS¥ ')¥}}] ""]
set blah [AEBuild -r $THINK "core" "getd" "----" $event]
regexp {ヌ.*ネ} $blah blah
return [specToPathName [string trim $blah {ヌネ}]]
}
proc thinkInclude {name} {
global THINK thinkpaths
if {[info exists thinkpaths]} {unset thinkpaths}
set event [join [concat {obj¥ ¥{want:type('prop'),¥ from:obj¥ ¥{want:type('SFIL'),¥ from:'null'(),¥ form:'name', seld:メ} [file tail $name] {モ¥},¥ form:'prop',¥ seld:type('INCL')¥}}] ""]
set blah [AEBuild -r $THINK "core" "getd" "----" $event]
if {![regexp {ヌ} $blah]} {return {{(No includes}}}
regsub -all {ネ[^ヌ]*ヌ} $blah { } raw
regsub {[^ヌ]*ヌ} $raw {} raw
regsub {ネ.*} $raw {} raw
foreach f $raw {
set path [specToPathName $f]
set tl [file tail $path]
set thinkpaths($tl) $path
lappend names $tl
}
return [lsort -ignore $names]
}
# Called by Alpha to get list of include files for popup.
proc thinkGetIncludeFiles {} {
if {[catch {thinkInclude [lindex [winNames] 0]} ret]} {
return {{(* THINK not running *}}
}
return $ret
}
# Called by Alpha to edit result of popup
proc thinkEditIncludeFile {name} {
global thinkpaths
edit $thinkpaths($name)
}
proc openHeader {} {
global thinkpaths
set name [lindex [winNames] 0]
if {![string length $name]} return
if {[catch {thinkInclude $name} names]} {
message "Think not running!"
beep
return
}
if {![string length $name] || [string match {(*} [lindex $names 0]]} {
message "No headers."
beep
return
}
set res [listpick -p {Include File?} $names]
if {[string length $res]} {edit $thinkpaths($res)}
}
#================================================================================
proc handleThinkReply { l } {
global thinkErrors teIndex ALPHA tileLeft tileTop tileWidth tileHeight winModes terrMenu errorHeight
set thinkErrors $l
switchTo $ALPHA
set teIndex 0
foreach err $l {
append lines "¥"[file tail [lindex $err 0]]¥"; " [format "Line %d: " [lindex $err 2]] [lindex $err 1] "¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥tー[lindex $err 0]ー[lindex $err 1]¥r"
}
new -n "* Compiler Errors *" -g $tileLeft $tileTop $tileWidth $errorHeight
insertText "(<cr> to go to error)¥r-----¥r" $lines
downBrowse
setWinInfo dirty 0
global winModes
set name [lindex [winNames] 0]
changeMode [set winModes($name) Brws]
}